home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 7 / Amiga Format AFCD07 (Dec 1996, Issue 91).iso / serious / shareware / programming / perl-5.003-complete / bin / s2p < prev   
Text File  |  1996-09-09  |  14KB  |  759 lines
  1. #!/ade/bin/perl
  2.  
  3. eval 'exec /ade/bin/perl -S $0 ${1+"$@"}'
  4.     if $running_under_some_shell;
  5.  
  6. $bin = '/ade/bin';
  7.  
  8. # $RCSfile: s2p.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 17:26:31 $
  9. #
  10. # $Log:    s2p.SH,v $
  11. # Revision 4.0.1.2  92/06/08  17:26:31  lwall
  12. # patch20: s2p didn't output portable startup code
  13. # patch20: added ... as variant on ..
  14. # patch20: s2p didn't translate s/pat/\&/ or s/pat/\$/ or s/pat/\\1/ right
  15. # 
  16. # Revision 4.0.1.1  91/06/07  12:19:18  lwall
  17. # patch4: s2p now handles embedded newlines better and optimizes common idioms
  18. # 
  19. # Revision 4.0  91/03/20  01:57:59  lwall
  20. # 4.0 baseline.
  21. # 
  22. #
  23.  
  24. $indent = 4;
  25. $shiftwidth = 4;
  26. $l = '{'; $r = '}';
  27.  
  28. while ($ARGV[0] =~ /^-/) {
  29.     $_ = shift;
  30.   last if /^--/;
  31.     if (/^-D/) {
  32.     $debug++;
  33.     open(BODY,'>-');
  34.     next;
  35.     }
  36.     if (/^-n/) {
  37.     $assumen++;
  38.     next;
  39.     }
  40.     if (/^-p/) {
  41.     $assumep++;
  42.     next;
  43.     }
  44.     die "I don't recognize this switch: $_\n";
  45. }
  46.  
  47. unless ($debug) {
  48.     open(BODY,">/tmp/sperl$$") ||
  49.       &Die("Can't open temp file: $!\n");
  50. }
  51.  
  52. if (!$assumen && !$assumep) {
  53.     print BODY &q(<<'EOT');
  54. :    while ($ARGV[0] =~ /^-/) {
  55. :        $_ = shift;
  56. :      last if /^--/;
  57. :        if (/^-n/) {
  58. :        $nflag++;
  59. :        next;
  60. :        }
  61. :        die "I don't recognize this switch: $_\\n";
  62. :    }
  63. :    
  64. EOT
  65. }
  66.  
  67. print BODY &q(<<'EOT');
  68. :    #ifdef PRINTIT
  69. :    #ifdef ASSUMEP
  70. :    $printit++;
  71. :    #else
  72. :    $printit++ unless $nflag;
  73. :    #endif
  74. :    #endif
  75. :    <><>
  76. :    $\ = "\n";        # automatically add newline on print
  77. :    <><>
  78. :    #ifdef TOPLABEL
  79. :    LINE:
  80. :    while (chop($_ = <>)) {
  81. :    #else
  82. :    LINE:
  83. :    while (<>) {
  84. :        chop;
  85. :    #endif
  86. EOT
  87.  
  88. LINE:
  89. while (<>) {
  90.  
  91.     # Wipe out surrounding whitespace.
  92.  
  93.     s/[ \t]*(.*)\n$/$1/;
  94.  
  95.     # Perhaps it's a label/comment.
  96.  
  97.     if (/^:/) {
  98.     s/^:[ \t]*//;
  99.     $label = &make_label($_);
  100.     if ($. == 1) {
  101.         $toplabel = $label;
  102.         if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
  103.         $_ = <>;
  104.         redo LINE; # Never referenced, so delete it if not a comment.
  105.         }
  106.     }
  107.     $_ = "$label:";
  108.     if ($lastlinewaslabel++) {
  109.         $indent += 4;
  110.         print BODY &tab, ";\n";
  111.         $indent -= 4;
  112.     }
  113.     if ($indent >= 2) {
  114.         $indent -= 2;
  115.         $indmod = 2;
  116.     }
  117.     next;
  118.     } else {
  119.     $lastlinewaslabel = '';
  120.     }
  121.  
  122.     # Look for one or two address clauses
  123.  
  124.     $addr1 = '';
  125.     $addr2 = '';
  126.     if (s/^([0-9]+)//) {
  127.     $addr1 = "$1";
  128.     $addr1 = "\$. == $addr1" unless /^,/;
  129.     }
  130.     elsif (s/^\$//) {
  131.     $addr1 = 'eof()';
  132.     }
  133.     elsif (s|^/||) {
  134.     $addr1 = &fetchpat('/');
  135.     }
  136.     if (s/^,//) {
  137.     if (s/^([0-9]+)//) {
  138.         $addr2 = "$1";
  139.     } elsif (s/^\$//) {
  140.         $addr2 = "eof()";
  141.     } elsif (s|^/||) {
  142.         $addr2 = &fetchpat('/');
  143.     } else {
  144.         &Die("Invalid second address at line $.\n");
  145.     }
  146.     if ($addr2 =~ /^\d+$/) {
  147.         $addr1 .= "..$addr2";
  148.     }
  149.     else {
  150.         $addr1 .= "...$addr2";
  151.     }
  152.     }
  153.  
  154.     # Now we check for metacommands {, }, and ! and worry
  155.     # about indentation.
  156.  
  157.     s/^[ \t]+//;
  158.     # a { to keep vi happy
  159.     if ($_ eq '}') {
  160.     $indent -= 4;
  161.     next;
  162.     }
  163.     if (s/^!//) {
  164.     $if = 'unless';
  165.     $else = "$r else $l\n";
  166.     } else {
  167.     $if = 'if';
  168.     $else = '';
  169.     }
  170.     if (s/^{//) {    # a } to keep vi happy
  171.     $indmod = 4;
  172.     $redo = $_;
  173.     $_ = '';
  174.     $rmaybe = '';
  175.     } else {
  176.     $rmaybe = "\n$r";
  177.     if ($addr2 || $addr1) {
  178.         $space = ' ' x $shiftwidth;
  179.     } else {
  180.         $space = '';
  181.     }
  182.     $_ = &transmogrify();
  183.     }
  184.  
  185.     # See if we can optimize to modifier form.
  186.  
  187.     if ($addr1) {
  188.     if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
  189.       $_ !~ / if / && $_ !~ / unless /) {
  190.         s/;$/ $if $addr1;/;
  191.         $_ = substr($_,$shiftwidth,1000);
  192.     } else {
  193.         $_ = "$if ($addr1) $l\n$change$_$rmaybe";
  194.     }
  195.     $change = '';
  196.     next LINE;
  197.     }
  198. } continue {
  199.     @lines = split(/\n/,$_);
  200.     for (@lines) {
  201.     unless (s/^ *<<--//) {
  202.         print BODY &tab;
  203.     }
  204.     print BODY $_, "\n";
  205.     }
  206.     $indent += $indmod;
  207.     $indmod = 0;
  208.     if ($redo) {
  209.     $_ = $redo;
  210.     $redo = '';
  211.     redo LINE;
  212.     }
  213. }
  214. if ($lastlinewaslabel++) {
  215.     $indent += 4;
  216.     print BODY &tab, ";\n";
  217.     $indent -= 4;
  218. }
  219.  
  220. if ($appendseen || $tseen || !$assumen) {
  221.     $printit++ if $dseen || (!$assumen && !$assumep);
  222.     print BODY &q(<<'EOT');
  223. :    #ifdef SAWNEXT
  224. :    }
  225. :    continue {
  226. :    #endif
  227. :    #ifdef PRINTIT
  228. :    #ifdef DSEEN
  229. :    #ifdef ASSUMEP
  230. :        print if $printit++;
  231. :    #else
  232. :        if ($printit)
  233. :        { print; }
  234. :        else
  235. :        { $printit++ unless $nflag; }
  236. :    #endif
  237. :    #else
  238. :        print if $printit;
  239. :    #endif
  240. :    #else
  241. :        print;
  242. :    #endif
  243. :    #ifdef TSEEN
  244. :        $tflag = 0;
  245. :    #endif
  246. :    #ifdef APPENDSEEN
  247. :        if ($atext) { chop $atext; print $atext; $atext = ''; }
  248. :    #endif
  249. EOT
  250.  
  251. print BODY &q(<<'EOT');
  252. :    }
  253. EOT
  254. }
  255.  
  256. close BODY;
  257.  
  258. unless ($debug) {
  259.     open(HEAD,">/tmp/sperl2$$.c")
  260.       || &Die("Can't open temp file 2: $!\n");
  261.     print HEAD "#define PRINTIT\n"    if $printit;
  262.     print HEAD "#define APPENDSEEN\n"    if $appendseen;
  263.     print HEAD "#define TSEEN\n"    if $tseen;
  264.     print HEAD "#define DSEEN\n"    if $dseen;
  265.     print HEAD "#define ASSUMEN\n"    if $assumen;
  266.     print HEAD "#define ASSUMEP\n"    if $assumep;
  267.     print HEAD "#define TOPLABEL\n"    if $toplabel;
  268.     print HEAD "#define SAWNEXT\n"    if $sawnext;
  269.     if ($opens) {print HEAD "$opens\n";}
  270.     open(BODY,"/tmp/sperl$$")
  271.       || &Die("Can't reopen temp file: $!\n");
  272.     while (<BODY>) {
  273.     print HEAD $_;
  274.     }
  275.     close HEAD;
  276.  
  277.     print &q(<<"EOT");
  278. :    #!$bin/perl
  279. :    eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  280. :        if \$running_under_some_shell;
  281. :    
  282. EOT
  283.     open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  284.     &Die("Can't reopen temp file: $!\n");
  285.     while (<BODY>) {
  286.     /^# [0-9]/ && next;
  287.     /^[ \t]*$/ && next;
  288.     s/^<><>//;
  289.     print;
  290.     }
  291. }
  292.  
  293. &Cleanup;
  294. exit;
  295.  
  296. sub Cleanup {
  297.     chdir "/tmp";
  298.     unlink "sperl$$", "sperl2$$", "sperl2$$.c";
  299. }
  300. sub Die {
  301.     &Cleanup;
  302.     die $_[0];
  303. }
  304. sub tab {
  305.     "\t" x ($indent / 8) . ' ' x ($indent % 8);
  306. }
  307. sub make_filehandle {
  308.     local($_) = $_[0];
  309.     local($fname) = $_;
  310.     if (!$seen{$fname}) {
  311.     $_ = "FH_" . $_ if /^\d/;
  312.     s/[^a-zA-Z0-9]/_/g;
  313.     s/^_*//;
  314.     $_ = "\U$_";
  315.     if ($fhseen{$_}) {
  316.         for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
  317.         $_ .= $tmp;
  318.     }
  319.     $fhseen{$_} = 1;
  320.     $opens .= &q(<<"EOT");
  321. :    open($_, '>$fname') || die "Can't create $fname: \$!";
  322. EOT
  323.     $seen{$fname} = $_;
  324.     }
  325.     $seen{$fname};
  326. }
  327.  
  328. sub make_label {
  329.     local($label) = @_;
  330.     $label =~ s/[^a-zA-Z0-9]/_/g;
  331.     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
  332.     $label = substr($label,0,8);
  333.  
  334.     # Could be a reserved word, so capitalize it.
  335.     substr($label,0,1) =~ y/a-z/A-Z/
  336.       if $label =~ /^[a-z]/;
  337.  
  338.     $label;
  339. }
  340.  
  341. sub transmogrify {
  342.     {    # case
  343.     if (/^d/) {
  344.         $dseen++;
  345.         chop($_ = &q(<<'EOT'));
  346. :    <<--#ifdef PRINTIT
  347. :    $printit = 0;
  348. :    <<--#endif
  349. :    next LINE;
  350. EOT
  351.         $sawnext++;
  352.         next;
  353.     }
  354.  
  355.     if (/^n/) {
  356.         chop($_ = &q(<<'EOT'));
  357. :    <<--#ifdef PRINTIT
  358. :    <<--#ifdef DSEEN
  359. :    <<--#ifdef ASSUMEP
  360. :    print if $printit++;
  361. :    <<--#else
  362. :    if ($printit)
  363. :        { print; }
  364. :    else
  365. :        { $printit++ unless $nflag; }
  366. :    <<--#endif
  367. :    <<--#else
  368. :    print if $printit;
  369. :    <<--#endif
  370. :    <<--#else
  371. :    print;
  372. :    <<--#endif
  373. :    <<--#ifdef APPENDSEEN
  374. :    if ($atext) {chop $atext; print $atext; $atext = '';}
  375. :    <<--#endif
  376. :    $_ = <>;
  377. :    chop;
  378. :    <<--#ifdef TSEEN
  379. :    $tflag = 0;
  380. :    <<--#endif
  381. EOT
  382.         next;
  383.     }
  384.  
  385.     if (/^a/) {
  386.         $appendseen++;
  387.         $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  388.         $lastline = 0;
  389.         while (<>) {
  390.         s/^[ \t]*//;
  391.         s/^[\\]//;
  392.         unless (s|\\$||) { $lastline = 1;}
  393.         s/^([ \t]*\n)/<><>$1/;
  394.         $command .= $_;
  395.         $command .= '<<--';
  396.         last if $lastline;
  397.         }
  398.         $_ = $command . "End_Of_Text";
  399.         last;
  400.     }
  401.  
  402.     if (/^[ic]/) {
  403.         if (/^c/) { $change = 1; }
  404.         $addr1 = 1 if $addr1 eq '';
  405.         $addr1 = '$iter = (' . $addr1 . ')';
  406.         $command = $space .
  407.           "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
  408.         $lastline = 0;
  409.         while (<>) {
  410.         s/^[ \t]*//;
  411.         s/^[\\]//;
  412.         unless (s/\\$//) { $lastline = 1;}
  413.         s/'/\\'/g;
  414.         s/^([ \t]*\n)/<><>$1/;
  415.         $command .= $_;
  416.         $command .= '<<--';
  417.         last if $lastline;
  418.         }
  419.         $_ = $command . "End_Of_Text";
  420.         if ($change) {
  421.         $dseen++;
  422.         $change = "$_\n";
  423.         chop($_ = &q(<<"EOT"));
  424. :    <<--#ifdef PRINTIT
  425. :    $space\$printit = 0;
  426. :    <<--#endif
  427. :    ${space}next LINE;
  428. EOT
  429.         $sawnext++;
  430.         }
  431.         last;
  432.     }
  433.  
  434.     if (/^s/) {
  435.         $delim = substr($_,1,1);
  436.         $len = length($_);
  437.         $repl = $end = 0;
  438.         $inbracket = 0;
  439.         for ($i = 2; $i < $len; $i++) {
  440.         $c = substr($_,$i,1);
  441.         if ($c eq $delim) {
  442.             if ($inbracket) {
  443.             substr($_, $i, 0) = '\\';
  444.             $i++;
  445.             $len++;
  446.             }
  447.             else {
  448.             if ($repl) {
  449.                 $end = $i;
  450.                 last;
  451.             } else {
  452.                 $repl = $i;
  453.             }
  454.             }
  455.         }
  456.         elsif ($c eq '\\') {
  457.             $i++;
  458.             if ($i >= $len) {
  459.             $_ .= 'n';
  460.             $_ .= <>;
  461.             $len = length($_);
  462.             $_ = substr($_,0,--$len);
  463.             }
  464.             elsif (substr($_,$i,1) =~ /^[n]$/) {
  465.             ;
  466.             }
  467.             elsif (!$repl &&
  468.               substr($_,$i,1) =~ /^[(){}\w]$/) {
  469.             $i--;
  470.             $len--;
  471.             substr($_, $i, 1) = '';
  472.             }
  473.             elsif (!$repl &&
  474.               substr($_,$i,1) =~ /^[<>]$/) {
  475.             substr($_,$i,1) = 'b';
  476.             }
  477.             elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
  478.             substr($_,$i-1,1) = '$';
  479.             }
  480.         }
  481.         elsif ($c eq '&' && $repl) {
  482.             substr($_, $i, 0) = '$';
  483.             $i++;
  484.             $len++;
  485.         }
  486.         elsif ($c eq '$' && $repl) {
  487.             substr($_, $i, 0) = '\\';
  488.             $i++;
  489.             $len++;
  490.         }
  491.         elsif ($c eq '[' && !$repl) {
  492.             $i++ if substr($_,$i,1) eq '^';
  493.             $i++ if substr($_,$i,1) eq ']';
  494.             $inbracket = 1;
  495.         }
  496.         elsif ($c eq ']') {
  497.             $inbracket = 0;
  498.         }
  499.         elsif ($c eq "\t") {
  500.             substr($_, $i, 1) = '\\t';
  501.             $i++;
  502.             $len++;
  503.         }
  504.         elsif (!$repl && index("()+",$c) >= 0) {
  505.             substr($_, $i, 0) = '\\';
  506.             $i++;
  507.             $len++;
  508.         }
  509.         }
  510.         &Die("Malformed substitution at line $.\n")
  511.           unless $end;
  512.         $pat = substr($_, 0, $repl + 1);
  513.         $repl = substr($_, $repl+1, $end-$repl-1);
  514.         $end = substr($_, $end + 1, 1000);
  515.         &simplify($pat);
  516.         $dol = '$';
  517.         $subst = "$pat$repl$delim";
  518.         $cmd = '';
  519.         while ($end) {
  520.         if ($end =~ s/^g//) {
  521.             $subst .= 'g';
  522.             next;
  523.         }
  524.         if ($end =~ s/^p//) {
  525.             $cmd .= ' && (print)';
  526.             next;
  527.         }
  528.         if ($end =~ s/^w[ \t]*//) {
  529.             $fh = &make_filehandle($end);
  530.             $cmd .= " && (print $fh \$_)";
  531.             $end = '';
  532.             next;
  533.         }
  534.         &Die("Unrecognized substitution command".
  535.           "($end) at line $.\n");
  536.         }
  537.         chop ($_ = &q(<<"EOT"));
  538. :    <<--#ifdef TSEEN
  539. :    $subst && \$tflag++$cmd;
  540. :    <<--#else
  541. :    $subst$cmd;
  542. :    <<--#endif
  543. EOT
  544.         next;
  545.     }
  546.  
  547.     if (/^p/) {
  548.         $_ = 'print;';
  549.         next;
  550.     }
  551.  
  552.     if (/^w/) {
  553.         s/^w[ \t]*//;
  554.         $fh = &make_filehandle($_);
  555.         $_ = "print $fh \$_;";
  556.         next;
  557.     }
  558.  
  559.     if (/^r/) {
  560.         $appendseen++;
  561.         s/^r[ \t]*//;
  562.         $file = $_;
  563.         $_ = "\$atext .= `cat $file 2>/dev/null`;";
  564.         next;
  565.     }
  566.  
  567.     if (/^P/) {
  568.         $_ = 'print $1 if /^(.*)/;';
  569.         next;
  570.     }
  571.  
  572.     if (/^D/) {
  573.         chop($_ = &q(<<'EOT'));
  574. :    s/^.*\n?//;
  575. :    redo LINE if $_;
  576. :    next LINE;
  577. EOT
  578.         $sawnext++;
  579.         next;
  580.     }
  581.  
  582.     if (/^N/) {
  583.         chop($_ = &q(<<'EOT'));
  584. :    $_ .= "\n";
  585. :    $len1 = length;
  586. :    $_ .= <>;
  587. :    chop if $len1 < length;
  588. :    <<--#ifdef TSEEN
  589. :    $tflag = 0;
  590. :    <<--#endif
  591. EOT
  592.         next;
  593.     }
  594.  
  595.     if (/^h/) {
  596.         $_ = '$hold = $_;';
  597.         next;
  598.     }
  599.  
  600.     if (/^H/) {
  601.         $_ = '$hold .= "\n"; $hold .= $_;';
  602.         next;
  603.     }
  604.  
  605.     if (/^g/) {
  606.         $_ = '$_ = $hold;';
  607.         next;
  608.     }
  609.  
  610.     if (/^G/) {
  611.         $_ = '$_ .= "\n"; $_ .= $hold;';
  612.         next;
  613.     }
  614.  
  615.     if (/^x/) {
  616.         $_ = '($_, $hold) = ($hold, $_);';
  617.         next;
  618.     }
  619.  
  620.     if (/^b$/) {
  621.         $_ = 'next LINE;';
  622.         $sawnext++;
  623.         next;
  624.     }
  625.  
  626.     if (/^b/) {
  627.         s/^b[ \t]*//;
  628.         $lab = &make_label($_);
  629.         if ($lab eq $toplabel) {
  630.         $_ = 'redo LINE;';
  631.         } else {
  632.         $_ = "goto $lab;";
  633.         }
  634.         next;
  635.     }
  636.  
  637.     if (/^t$/) {
  638.         $_ = 'next LINE if $tflag;';
  639.         $sawnext++;
  640.         $tseen++;
  641.         next;
  642.     }
  643.  
  644.     if (/^t/) {
  645.         s/^t[ \t]*//;
  646.         $lab = &make_label($_);
  647.         $_ = q/if ($tflag) {$tflag = 0; /;
  648.         if ($lab eq $toplabel) {
  649.         $_ .= 'redo LINE;}';
  650.         } else {
  651.         $_ .= "goto $lab;}";
  652.         }
  653.         $tseen++;
  654.         next;
  655.     }
  656.  
  657.     if (/^y/) {
  658.         s/abcdefghijklmnopqrstuvwxyz/a-z/g;
  659.         s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
  660.         s/abcdef/a-f/g;
  661.         s/ABCDEF/A-F/g;
  662.         s/0123456789/0-9/g;
  663.         s/01234567/0-7/g;
  664.         $_ .= ';';
  665.     }
  666.  
  667.     if (/^=/) {
  668.         $_ = 'print $.;';
  669.         next;
  670.     }
  671.  
  672.     if (/^q/) {
  673.         chop($_ = &q(<<'EOT'));
  674. :    close(ARGV);
  675. :    @ARGV = ();
  676. :    next LINE;
  677. EOT
  678.         $sawnext++;
  679.         next;
  680.     }
  681.     } continue {
  682.     if ($space) {
  683.         s/^/$space/;
  684.         s/(\n)(.)/$1$space$2/g;
  685.     }
  686.     last;
  687.     }
  688.     $_;
  689. }
  690.  
  691. sub fetchpat {
  692.     local($outer) = @_;
  693.     local($addr) = $outer;
  694.     local($inbracket);
  695.     local($prefix,$delim,$ch);
  696.  
  697.     # Process pattern one potential delimiter at a time.
  698.  
  699.     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
  700.     $prefix = $1;
  701.     $delim = $2;
  702.     if ($delim eq '\\') {
  703.         s/(.)//;
  704.         $ch = $1;
  705.         $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
  706.         $ch = 'b' if $ch =~ /^[<>]$/;
  707.         $delim .= $ch;
  708.     }
  709.     elsif ($delim eq '[') {
  710.         $inbracket = 1;
  711.         s/^\^// && ($delim .= '^');
  712.         s/^]// && ($delim .= ']');
  713.     }
  714.     elsif ($delim eq ']') {
  715.         $inbracket = 0;
  716.     }
  717.     elsif ($inbracket || $delim ne $outer) {
  718.         $delim = '\\' . $delim;
  719.     }
  720.     $addr .= $prefix;
  721.     $addr .= $delim;
  722.     if ($delim eq $outer && !$inbracket) {
  723.         last DELIM;
  724.     }
  725.     }
  726.     $addr =~ s/\t/\\t/g;
  727.     &simplify($addr);
  728.     $addr;
  729. }
  730.  
  731. sub q {
  732.     local($string) = @_;
  733.     local($*) = 1;
  734.     $string =~ s/^:\t?//g;
  735.     $string;
  736. }
  737.  
  738. sub simplify {
  739.     $_[0] =~ s/_a-za-z0-9/\\w/ig;
  740.     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
  741.     $_[0] =~ s/a-za-z_0-9/\\w/ig;
  742.     $_[0] =~ s/a-za-z0-9_/\\w/ig;
  743.     $_[0] =~ s/_0-9a-za-z/\\w/ig;
  744.     $_[0] =~ s/0-9_a-za-z/\\w/ig;
  745.     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
  746.     $_[0] =~ s/0-9a-za-z_/\\w/ig;
  747.     $_[0] =~ s/\[\\w\]/\\w/g;
  748.     $_[0] =~ s/\[^\\w\]/\\W/g;
  749.     $_[0] =~ s/\[0-9\]/\\d/g;
  750.     $_[0] =~ s/\[^0-9\]/\\D/g;
  751.     $_[0] =~ s/\\d\\d\*/\\d+/g;
  752.     $_[0] =~ s/\\D\\D\*/\\D+/g;
  753.     $_[0] =~ s/\\w\\w\*/\\w+/g;
  754.     $_[0] =~ s/\\t\\t\*/\\t+/g;
  755.     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
  756.     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
  757. }
  758.  
  759.